home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
wildcat
/
qwkhold1.zip
/
QWK2MAKE.WCC
< prev
next >
Wrap
Text File
|
1996-05-13
|
28KB
|
594 lines
'QWK2MAKE.WCC by James Mardis (FidoNet 1:322/746) 5/7/96
'
' This program makes QWK Mail made for callers to pick up later.
' It is used with the companion programs LOGON2.WCC and QWK2HOLD.WCC.
' This program is intended to be run from a DOS BATCH program immediately
' after your mail has been processed.
'
' A short batch program entry could look like the following:
'
' C:
' CD\WILDCAT
' ECHO Turn on inbound mail flag > QWK2MA1.FLG
' Manditory line --> SET WCPORTID=0
' Manditory line --> WILDCAT /R QWK2MAKE.WCX
'
'
'The configuration file, QWK2HOLD.CFG breaks down as follows:
'Line #1, Complete PathName where WCMAIL QWK stores mail packets,
' such as C:\WILDCAT\MAIL\QWK\
'
'Line #2, File area number for QWK Mail that was choosen in the Makewild
' QWK Mail area.
'
'Line #3, Complete PathName where QWK2 can store all user mail packets.
'
'Line #4, Valid values are COMMENT(1) thru COMMENT(5) exactly as shown.
' The right and left parentheses around the number are
' manditory.
'
' The actual value found in the user's COMMENT(?) field will
' contain either QWK2 ON XX or QWK2 OFF XX where XX equals
' the number of mail packets that are currently in storage.
' The XX field must begin at character 10 in the comment field.
'
'Line #5, Security Profile #1 to exclude from operating this program.
' I use this to bar NEWUSER from this program
' while allowing them access to other WCX programs.
' If not used set it to NO SEC1.
'
'Line #6, Security Profile #2 to exclude from operating this program.
' If not used set it at NO SEC2.
'
'Line #7 Maximum number of QWK packets a caller can have waiting for pickup.
' Valid values are 1 to 26.
'
'Line #8 Maximum number of days to keep stored QWK packets.
' Valid values are 1 to 365.
'
'Line #9 Maximum allowed storage space for user packets in bytes, but
' a minimum of 1 packet is allowed regardless of this value.
' Valid values are 1 to 2147483647, this is in bytes like
' what you see when listing a DOS directory from DOS.
'
'Line #10 Conference number where user messages are to be sent.
' Messages will be sent with the Private flag turned on.
'
'Line #11 Prompt colors normal for Text and Background, leave off @ symbols.
' Default two character code is 0E.
'
'Line #12 Prompt colors normal for Highlighted Text.
' Default two character code is 0B.
'
'Line #13 Prompt colors normal for Packet size and elsewhere.
' Default two character code is 0C.
'
'Line #14 Prompt colors normal for warning messages.
' Default two character code is 0E.
'
'Line #15 Path to inbound mail flag, Where to look for QWK2MA?.FLG.
'
'Line #16 Text to display when Mail Flag #1 is found.
'
'Line #17 Text to display when Mail Flag #2 is found.
'
'Line #18 Text to display when Mail Flag #3 is found.
'
'Line #19 Text to display when Mail Flag #4 is found.
'
'Line #20 Text to display when Mail Flag #5 is found.
'
'The first time this program is ever run it will move all packets found
'to the stored packet directory.
'
EnablePages Off 'Ignore pages until program ends.
dim BadEnd as Integer 'Value to trigger program failure message.
dim ChaStr1 as String 'Junk String Variable, re-used at will.
dim ChaStr2 as String 'Junk String Variable, re-used at will.
dim CurCode as Date 'Current Date while in ddmmyyyy format.
dim CurDate as Integer 'Current date coded in DOS format.
dim CurDay as String 'Current Day while code is run.
dim CurMonth as String 'Current Month while code is run.
dim CurYear as String 'Current Year while code is run.
dim FileDos as Word 'File date in DOS code format.
dim FileNm2 as String 'Used to Open assorted files.
dim FileSearch as SearchRec 'Search record array for file info.
dim FileSize as Long 'Current file size.
dim FindQWK as Integer '"For" loop counter vailable.
dim FindUser as Integer '"For" loop counter variable.
dim FlagChk as Integer 'User QWK2 ON/OFF flag variable.
dim MailProc1 as String 'QWK.CFG #16, Prompt for mail flag #1
dim MailProc2 as String 'QWK.CFG #17, Prompt for mail flag #2
dim MailProc3 as String 'QWK.CFG #18, Prompt for mail flag #3
dim MailProc4 as String 'QWK.CFG #19, Prompt for mail flag #4
dim MailProc5 as String 'QWK.CFG #20, Prompt for mail flag #5
dim MaxAge as Integer 'QWK2HOLD.CFG #8, Maximum # of days packets kept.
dim MaxPacket as Integer 'QWK2HOLD.CFG #7, Maximum allowed QWK packets.
dim MaxSize as Long 'QWK2HOLD.CFG #9, Maximum size of all packets.
dim MsgHd as MessageHeader 'Used to send messages.
dim MsgPlace as Integer 'QWK2HOLD.CFG #10, Conference where messages go.
dim NewFile as String 'New QWK file name.
dim NodeRec as NodeInfoRecord'Array to contain current node being checked.
dim NumInt1 as Integer 'Junk Integer Variable, re-used at will.
dim NumInt2 as Integer 'Junk Integer Variable, re-used at will.
dim OldAge as Integer 'Oldest number of packet days in existance.
dim OldFile as String 'Old QWK file name.
dim UserOnline as Boolean 'Is user Online somewhere, if True (-1) or False (0).
dim P1 as String 'QWK.CFG #11, Prompt #1 Color.
dim P2 as String 'QWK.CFG #12, Prompt #2 Color.
dim P3 as String 'QWK.CFG #13, Prompt #3 Color.
dim P4 as String 'QWK.CFG #14, Prompt #4 Color.
dim QWKAge as Integer 'Current age of the packet in days.
dim QWKFlag as String 'QWK2HOLD.CFG #4, QWK search variable.
dim QWKInbound as String 'QWK2HOLD.CFG #15, Path to mail flag.
dim QWKLocal as String 'Path where Sysop's local QWK packets wind up.
dim QWKRoute as String 'QWK2HOLD.CFG #3, Path to QWK2 mail packets.
dim QWKTotal as Integer 'Total number of QWK packets for user.
dim QWKLeft as Integer 'Total number of QWK packets a user has left.
dim QWKSysop as String 'Path choosen by Sysop for local transfer.
dim SecPro1 as String 'QWK2HOLD.CFG #5, Security Profile #1 restriction.
dim SecPro2 as String 'QWK2HOLD.CFG #6, Security Profile #2 restriction.
dim Size as Long 'Place to store total size of stored packets.
dim UKey as String 'Used to determine user's choice.
dim UserRec as UserRecord 'Create temporary array for user record.
dim WCMailRoute as String 'QWK2HOLD.CFG #1, Path where WCMAIL stores packets.
dim WCMailZip as Integer 'QWK2HOLD.CFG #2, File area number used in WCMAIL.
dim QWKDown as String 'Used to determine if user wants to download QWK.
'
'Time to read in the QWK2HOLD.CFG file.
EnablePages Off ' Disable inbound page till program ends, resets at end.
FileNm2 = ProgPath + "QWK2HOLD.CFG" 'QWK2HOLD.CFG is the configuration file.
If Exists (FileNm2) then 'If QWK2HOLD.CFG exists, get data.
OPEN FileNm2 for Input as #1 'Open CFG file for reading.
If Not(local) Then CarrierCheck Off 'Ignore modem till entire file read.
LockFile (1,0,1) 'Temporary file lock for multinode use.
Input #1, WCMailRoute '#1, Path where WCMAIL stores packets.
Input #1, WCMailZip '#2, File directory # from MAKEWILD(WCMAIL).
Input #1, QWKRoute '#3, Path to QWK Mail Packets.
Input #1, QWKFlag '#4, User QWK Comment(?) action.
Input #1, SecPro1 '#5, Security Exclusion Value #1.
Input #1, SecPro2 '#6, Security Exclusion Value #2.
Input #1, MaxPacket '#7, Maximum number of user QWK Packets.
Input #1, MaxAge '#8, Maximum # of days to keep stored packets.
Input #1, MaxSize '#9, Maximum size of storage for user packets.
Input #1, MsgPlace '#10, Conference number where messages are to go.
Input #1, P1 '#11, Prompt color for normal text.
Input #1, P2 '#12, Prompt color for highlighted text.
Input #1, P3 '#13, Prompt color for Packet size.
Input #1, P4 '#14, Prompt color for Alert Messages.
Input #1, QWKInbound '#15, Path to inbound mail flag, if mail processing.
Input #1, MailProc1 '#16, Mail Processing message #1.
Input #1, MailProc2 '#17, Mail Processing message #2.
Input #1, MailProc3 '#18, Mail Processing message #3.
Input #1, MailProc4 '#19, Mail Processing message #4.
Input #1, MailProc5 '#20, Mail Processing message #5.
UnlockFile (1,0,1) 'Remove temporary file lock.
Close #1 'Close the CFG file.
If Not(Local) Then CarrierCheck On 'File read, exit if carrier dropped.
Else 'Go here if no CFG file is found.
BadEnd = 0 'Set up error message.
Goto Problem 'No CFG file was found, abort the program.
End If 'End of LOGIN2.CFG input.
'Validate read QWK2HOLD.CFG file data.
If WCMailRoute = "" Then
BadEnd = 1: Goto Problem 'WCMail Path missing, QWK2HOLD.CFG LINE #1.
Else 'WCMailroute actually contains something.
WCMailRoute = Trim(UCase(WCMailRoute)) 'Make it Uppercase & Trim spaces.
If Mid(WCMailRoute,2,2) <> ":\" Then BadEnd = 1: Goto Problem
If Right(WCMailRoute,1) <> "\" Then 'Verify path ends in a backslash.
WCMailRoute = WCMailRoute + "\" 'Slash was added.
End If 'End of WCMailRoute slash check.
End If 'End of WCMailRoute check.
If QWKRoute = "" Then
BadEnd = 2: Goto Problem 'QWKRoute missing, QWK2HOLD.CFG LINE #2.
Else 'QWKRoute actually contains something.
QWKRoute = Trim(UCase(QWKRoute)) 'Make it Uppercase & Trim spaces.
IF Mid(QWKRoute,2,2) <> ":\" Then BadEnd = 2: Goto Problem
IF Right(QWKRoute,1) <> "\" Then 'Verify path ends in backslash.
QWKRoute = QWKRoute + "\" 'Slash was added.
End If 'End of QWKRoute slash check.
End If 'End of QWKRoute check.
If QWKFlag = "" Then 'Does QWKFlag value exist in the CFG file.
BadEnd = 3: Goto Problem 'QWKFlag missing, QWK2HOLD.CFG Line #3.
Else 'QWKFlag actually contains something.
QWKFlag = UCase(QWKFlag) 'Make it Uppercase.
End If' End of If QWKFlag.
If SecPro1 = "" Then
SecPro1 = "NO SEC1" 'If no QWK2HOLD.CFG Line #5, set value.
Else 'SecPro1 actually contains something.
SecPro1 = Trim(UCase(SecPro1)) 'Make it Uppercase & Trim spaces.
End If
If SecPro2 = "" Then
SecPro2 = "NO SEC2" 'If no QWK2HOLD.CFG Line #6, set value.
Else 'SecPro2 actually contains something.
SecPro2 = Trim(UCase(SecPro2)) 'Make it Uppercase & Trim spaces.
End If
If QWKInbound = "" Then
BadEnd = 15: Goto Problem 'QWKInbound missing, QWK2HOLD.CFG LINE #15.
Else 'QWKInbound actually contains something.
QWKInbound = Trim(UCase(QWKInbound)) 'Make it Uppercase & Trim spaces.
IF Mid(QWKInbound,2,2) <> ":\" Then BadEnd = 15: Goto Problem
IF Right(QWKInbound,1) <> "\" Then 'Verify path ends in backslash.
QWKInbound = QWKInbound + "\" 'Slash was added.
End If 'End of QWKInbound slash check.
End If 'End of QWKInbound check.
If MaxPacket <= 0 Then MaxPacket = 1 'Minimum value is 1.
If MaxPacket >= 26 Then MaxPacket = 26 'Had to set a limit somewhere.
If MaxAge <= 0 Then MaxAge = 0 'Keep the old packets forever.
If MaxAge >= 365 Then MaxAge = 365 'Maximum life of packets is 1 year.
If MaxSize <= 0 Then MaxSize = 2147483647 'If zero, set limit at highest.
If MaxSize >= 2147483647 Then MaxSize = 2147483647 'Set maximum size limit.
If P1 = "" or Len(P1) <> 2 Then 'Check prompt P1, normal text.
P1 = "@0E@" 'Set default prompt.
Else P1 = "@" + UCase(P1) + "@"
End If
If P2 = "" or Len(P2) <> 2 Then 'Check prompt P2, highlighted text.
P2 = "@0F@" 'Set default prompt.
Else P2 = "@" + UCase(P2) + "@"
End If
If P3 = "" or Len(P3) <> 2 Then 'Check prompt P3, Packet sizes.
P3 = "@0B@" 'Set default prompt.
Else P3 = "@" + UCase(P3) + "@"
End If
If P4 = "" or Len(P4) <> 2 Then 'Check prompt P4, alert text.
P4 = "@0C@" 'Set default prompt.
Else P4 = "@" + UCase(P4) + "@"
End If
CurrentDate(CurCode) 'Put date into CurDate.
ChaStr1 = FormatDate(CurCode,"ddmmyyyy") 'Convert data into usable String.
CurDay = Left(ChaStr1,2) 'Current Day established, used for CurDate.
CurMonth = Mid(ChaStr1,3,2) 'Current Month established, used for CurDate.
CurYear = Mid(ChaStr1,5,4) 'Current Year established, used for CurDate.
'Following line codes Wildcat! date to DOS style date for comparisons.
CurDate = ((Val(CurYear)-1980)*512) + (Val(CurMonth)*32)+Val(CurDay)
If WCMailRoute = QWKRoute Then
BadEnd = 3
ChaStr2 = "QWK2: Line #1 and Line #3 of QWK2HOLD.CFG MUST NOT be the same."
Print ChaStr2
ActivityLog ChaStr2
Goto Problem
End If
'>>>----> End of Configuration file and variable setup.
'Clean up loop, in case caller lost carrier during downloading.
NumInt1 = 0
FindQWK = 0
Do While FindQWK < MaxPacket
NewFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(NumInt1 + 65)
OldFile = QWKRoute + Str(User.UserID) + ".QW" + Chr(FindQWK + 65)
If Exists(OldFile) Then 'OldFile already exists so go add one and go on.
FindQWK = FindQWK + 1
NumInt1 = NumInt1 + 1
If OldFile <> NewFile Then 'OldFile exists but does it match Newfile
Name OldFile as NewFile' Nope, rename Oldfile to fill gap.
End If 'End of If Oldfile <> Newfile
ELSE 'Oldfile was not found, increment and go thru loop again.
FindQWK = FindQWK + 1
End If 'End of If Exists(Oldfile)
Loop
QWKTotal = NumInt1
'End of Clean up loop
'>>>----> Find out which users want packets made for them.
'User Id's are what WCMAIL uses when it creates & names QWK mail packets.
'User Names or User ID's are WCMAIL variables used to make QWK packets.
MorePrompt Off
ChaStr2 = "QWK2: Packet Storage program has started"
ActivityLog ChaStr2
FileNm2 = ProgPath + "QWK2WAIT.BAT" 'Batch program of busy callers.
If Exists (FileNm2) Then Del FileNm2 'Get rid of any old list.
GetFirstUser(UserRec, 5) 'Go to top of file record, get first user.
FlagChk = Val(Mid(QWKFlag,9,1))
If UCase(Trim(Left(UserRec.Comment(FlagChk),8))) = "QWK2 ON" Then
UserOnline = False
Print P4;"QWK2 ON";P1;" ---> [";P2;UserRec.UserID;P1;"] [";P3;UserRec.Name;P1;"].": Delay 4
Size = 0'Zero total packet size counter for user.
Gosub MainProg1 'Process user list and make packets if needed.
ELSE
Print P1;"QWK2 OFF --> [";P2;UserRec.UserID;P1;"] [";P3;UserRec.Name;P1;"]."
End If
Print "Finished checking first user record."
While GetNextUser(UserRec, 5) 'Get the other User's information.
UserOnline = False
FlagChk = Val(Mid(QWKFlag,9,1))
If UCase(Trim(Left(UserRec.Comment(FlagChk),8))) = "QWK2 ON" Then
Print P4;"QWK2 ON";P1;" ---> [";P2;UserRec.UserID;P1;"] [";P3;UserRec.Name;P1;"].": Delay 4
Gosub MainProg1 'Process user list and make packets if needed.
ELSE
Print P1;"QWK2 OFF --> [";P2;UserRec.UserID;P1;"] [";P3;UserRec.Name;P1;"]."
End If
Wend 'Locate next user's file and get information.
Gosub CleanOut 'Remove Abandoned (user account deleted) or over age packets.
'Delete any raised QWK2 mail flags.
If Exists(QWKInbound + "QWK2MA1.FLG") Then Del QWKInbound + "QWK2MA1.FLG"
If Exists(QWKInbound + "QWK2MA2.FLG") Then Del QWKInbound + "QWK2MA2.FLG"
If Exists(QWKInbound + "QWK2MA3.FLG") Then Del QWKInbound + "QWK2MA3.FLG"
If Exists(QWKInbound + "QWK2MA4.FLG") Then Del QWKInbound + "QWK2MA4.FLG"
If Exists(QWKInbound + "QWK2MA5.FLG") Then Del QWKInbound + "QWK2MA5.FLG"
Finished:
ChaStr2 = "QWK2: Packet Storage program has ended."' The program's over.
ActivityLog ChaStr2
MorePrompt On
End
'>>>----> Place for this program to end.
'>>>----> Start of MainProg1
MainProg1:
Print P1;"QWK2: ";P3;UserRec.Name;P1;" Verifying user account is not open.":Delay 2
FileNm2 = ProgPath + "QWK2WAIT.BAT" 'Batch program of busy callers.
NumInt1 = 0
BadEnd = 0
Size = 0
While NumInt1 <= MaxNode
GetNodeInfo NodeRec, NumInt1
If NodeRec.NodeStatus = 3 Then'Is node is online.
If Trim(NodeRec.CallersName) = UCase(Trim(UserRec.Name)) Then 'Was user on node.
UserOnline = True
'User is currently Online, add user to list of names for later processing.
OPEN FileNm2 for Append as #2 'Open QWK2WAIT.BAT file for writing.
LockFile (2,0,1) 'Temporary file lock for multinode use.
ChaStr1 = "WCMAIL " + UCase(Trim(UserRec.Name)) + " /PRESCAN" 'Shell Variables.
Print #2,ChaStr1
UnlockFile (2,0,1)
Close #2
ChaStr2 = "QWK2: "+UserRec.Name+"'s account was found open on node "+Str(NumInt1)+"."
ActivityLog ChaStr2
Print P1;"QWK2: ";P3;UserRec.Name;"'s";P1;" account found ";P4;"active";P1;" on Node #";P3;NumInt1;P1;"!": Delay 2
NumInt1 = MaxNode + 1
End If 'If Trim(NodeRec.CallersName).
End If 'If (NodeRec.NodeStatus.
NumInt1 = NumInt1 + 1
Wend 'End of While loop
NumInt1 = 0
ChaStr2 = ""
FileNm2 = ""
Print P1;"QWK2: ";P3;UserRec.Name;P1;" Finished verifying account status.":Delay 2
'Begin processing user mail at this time.
If UserOnline = True Then Return 'User Is online, so skip subroutine.
'>>>----> First make sure user's packet(s) start with letter A & no gaps.
' Needed in case a user lost carrier during a QWK download.
NumInt1 = 0
FindQWK = 0
Print P1;"QWK2: ";P3;UserRec.Name;P1;" Checking for existing and New packets."
Do While FindQWK < MaxPacket
NewFile = QWKRoute + Str(UserRec.UserID) + ".QW" + Chr(NumInt1 + 65)
OldFile = QWKRoute + Str(UserRec.UserID) + ".QW" + Chr(FindQWK + 65)
If Exists(OldFile) Then 'OldFile already exists so go add one and go on.
FindQWK = FindQWK + 1
NumInt1 = NumInt1 + 1
If OldFile <> NewFile Then 'OldFile exists but does it match Newfile
Name OldFile as NewFile' Nope, rename Oldfile to fill gap.
End If 'End of If Oldfile <> Newfile
ELSE 'Oldfile was not found, increment and go thru loop again.
FindQWK = FindQWK + 1
End If 'End of If Exists(Oldfile)
Loop
CLS
Locate 8,1
Print P1;"QWK2: ";P3;UserRec.Name;P1;" Checking storage depot."
FindQWK = 0
QWKTotal = 0
OldAge = 0
Size = 0
Do While FindQWK < MaxPacket 'Start search for stored packets.
NewFile = QWKRoute + Str(UserRec.UserID) + ".QW" + Chr(QWKTotal + 65)
If Exists(NewFile) Then 'Checking for existing stored packet.
QWKTotal = QWKTotal + 1'Existing packet count incremented.
FindFirst(NewFile,0,FileSearch)
FileSize=FileSearch.Size
FileDos=FileSearch.DosDate
Size = Size + FileSearch.Size
MorePrompt Off
Locate 10,1
CLREOL
Print P1;"QWK2: ";P3;UserRec.Name;P1;" Last stored packet found was ";P2;FileSearch.Name;P1;"."
Print
Print P1;"Total Packets Found ......... ";
If QWKTotal > MaxPacket Then
Print P4;QWKTotal
Else
Print P2;QWKTotal
End If
Print P1;"Maximum # Packets Allowed ... ";P2;MaxPacket
CLREOL
Print P1;"Last Checked Packet Size .... ";P2;FileSize;P1;" Bytes"
Print P1;"Total Packet Storage ........ ";
If Size > MaxSize Then
Print P4;Size;P1;" Bytes"
Else
Print P2;Size;P1;" Bytes"
End If
Print P1;"Packet Storage Maximum ...... ";P2;MaxSize;P1;" Bytes"
CLREOL
Print P1;"Packet Age Maximum .......... ";P2;MaxAge;P1;" Day(s)"
If CurDate - FileDos > OldAge then OldAge = CurDate - FileDos
Print P1;"Oldest Packet Age was ....... ";
If OldAge > MaxAge Then
Print P4;OldAge;P1;" Day(s)"
Else
Print P2;OldAge;P1;" Days(s)"
End If
CLREOL
End If 'Done Checking for existing packet.
FindQWK = FindQWK + 1
Loop 'Found one so go and look for another.
Delay 3 '3 seconds delay for display effect only.
Print
If (QWKTotal < MaxPacket) and (Size < MaxSize) Then 'No age check 1st time.
ChaStr1 = QWKRoute + Str(UserRec.UserID) + ".QW" 'Partial NewFile var.
NewFile = ChaStr1 + Chr(QWKTotal + 65) 'Newfile variable.
OldFile = WCMailRoute + Str(UserRec.UserID) + ".QWK" 'OldFile Variable.
If Exists(OldFile) Then 'Get ready to relocate WCMAIL QWK Packet.
CopyFile(OldFile,NewFile) 'Copy WCMAIL QWK packet to storage.
ChaStr1 = Str(UserRec.UserId) + ".QWK"
DeleteFile(ChaStr1,WCMailZip,1) 'Delete old QWK file from disk & records.
QWKTotal = QWKTotal + 1'Increment total number of stored packets.
FindFirst(NewFile,0,FileSearch) 'Establish FileSearch variable.
FileSize=FileSearch.Size'Determine packet file size.
Size = Size + FileSearch.Size 'Increment size of stored packets.
End If 'WCMail Packet has been moved to storage.
End If 'So much for existing packets when this program started.
Do While (QWKTotal < MaxPacket) and (Size < MaxSize) and (OldAge < MaxAge)
CLS
ChaStr1 = "WCMAIL " + Trim(UserRec.Name) + " /PRESCAN" 'Shell Variables.
Shell ChaStr1 'Try and create a new QWK Packet.
If Exists(OldFile) Then 'Check to see if a new one was made.
ChaStr1 = QWKRoute + Str(UserRec.UserId) + ".QW" 'Partial NewFile.
NewFile = ChaStr1 + Chr(QWKTotal + 65) 'NewFile variable.
OldFile = WCMailRoute + Str(UserRec.UserID) + ".QWK" 'OldFile variable.
CopyFile(OldFile,NewFile) 'Copy new QWK file to Storage.
ChaStr1 = Str(UserRec.UserID) + ".QWK" 'Load deletion variables.
DeleteFile(ChaStr1,WCMailZip,1) 'Remove QWK from Wildcat Files.
FindFirst(NewFile,0,FileSearch) 'Establish FileSearch variable.
ChaStr1 = "QWK2: " + UserRec.Name + " had the new packet moved to"
ChaStr1 = ChaStr1 + " storage location " + FileSearch.Name+ "."
ActivityLog ChaStr1
FileSize = FileSearch.Size 'Determine packet file size.
Size = Size + FileSearch.Size 'Increment size of stored packets.
QWKTotal = QWKTotal + 1 'Increment total number of user stored QWK's.
ELSE
Exit Do: Return'Quit this Do Loop early.
End If 'A new packet was made and placed into storage.
Loop 'If room and mail still not all packetized make another packet.
Print P1;"QWK2: ";P3;UserRec.Name;P1;" Finished checking and or making packets.":Delay 3
'Check packets for expiration date, advise of exceeded values if needed.
'Update user record with QWKTotal and QWK2 to OFF if needed.
If UserOnline = True Then Return 'User Is online, so skip subroutine.
Print P1;"QWK2: ";P3;UserRec.Name;P1;" Checking for any exceeded limits.":Delay 2
NumInt2 = Val(Mid(QWKFlag,9,1))
ChaStr1 = Pad(UCase(Left(UserRec.Comment(NumInt2),9)),9)'Load QWK ON/OFF.
UserRec.Comment(Val(Mid(QWKFlag,9,1))) = ChaStr1 'Load Values.
If QWKTotal >= MaxPacket Then 'Too many packets exist for user.
ChaStr1 = "QWK2: " + UserRec.Name + " has reached the QWK2 MaxPacket limit of "
ChaStr1 = ChaStr1 + Str(MaxPacket) + "."
ActivityLog ChaStr1 'Make the log entry.
End If
If Size >= MaxSize Then 'Too much storage space in use by user.
ChaStr1 = "QWK2: " + UserRec.Name + " has exceeded the QWK2 MaxSize limit of "
ChaStr1 = ChaStr1 + Str(MaxSize) + "."
ActivityLog ChaStr1 'Make the log entry.
End If
If OldAge >= MaxAge Then 'Stored packet exceeds MaxAge limit.
ChaStr1 = "QWK2: " + UserRec.Name + " has QWK2 packet(s) that reached the "
ChaStr1 = ChaStr1 + "old age of " + Str(MaxAge) + " days."
ActivityLog ChaStr1 'Make 1st part of log entry.
ChaStr1 = "QWK2: " + UserRec.Name + " had the Automated QWK option turned off."
ActivityLog ChaStr1 'Make 2nd part of log entry.
UserRec.Comment(Val(Mid(QWKFlag,9,1))) = "QWK2 OFF " 'Load Values.
'Send message notifying user the warning message.
ChaStr2 = Chr(13) + Chr(13)
ChaStr1 = "This is an automated message." + ChaStr2
ChaStr1 = ChaStr1 + "The automatic mail packets you requested are not" + \
" being picked up." + ChaStr2
ChaStr1 = ChaStr1 + "This option has been turned off and packets found" + \
" after 15 days will be deleted."
If Exists(ProgPath + "QWK2WARN.TXT") Then 'Check for existance of text msg.
ChaStr1 = ProgPath +"QWK2WARN.TXT" 'Replace above default message.
End If' Done with warning message checking.
MsgHd.To = UserRec.Name 'User to send message to.
MsgHd.From = MakeWild.SysopName 'Tell user message is from sysop.
FlagSet(MsgHd.Flags, &H01)' Set message flag on.
FlagSet(MsgHd.Flags, &H02)' Set message flag on.
MsgHd.Subject = "QWK Age Limit"
AddMessage(MsgHd, ChaStr1, , MsgPlace)
ChaStr2 = P1 + "QWK2: " + P3 + UserRec.Name + P1 + " was sent a message advising of old mail."
ActivityLog ChaStr2 'Make the log entry.
End If 'Done with Old date checking.
UpdateUser(UserRec) 'Make actual User Record update now.
Print P1;"QWK2: ";P3;UserRec.Name;P1;" Finished checking limits.": Delay 3
Return 'Proper end of MainProg1
'>>>----> End of MainProg1
'>>>----> Start of CleanOut
CleanOut: 'Used to delete packets that are over expiration date.
Print P1;"QWK2: Checking for any expired packets.":Delay 3
ChaStr1 = QWKRoute + "*.QW?" 'Set file spec we want to verify age of.
NumInt2 = FindFirst(ChaStr1,0,FileSearch) 'Get file information.
CLS
MorePrompt Off
Locate 8,1
Print P1;"Deleting any QWK2 Packets over ";P2;MaxAge + 15;P1;" days old."
Locate 10,1
Print P1;" FileName AGE Size"
Do While NumInt2 = 0 'Setup loop
Locate 12,1
CLREOL
Print P1;LeftPad(FileSearch.Name,12);
If (CurDate - FileSearch.DosDate) > MaxAge Then
Print P4;
Else
Print P2;
End If
Print LeftPad(Str(CurDate - FileSearch.DosDate),7);
Print P3;LeftPad(Str(FileSearch.Size),14)
If (CurDate - FileSearch.DosDate) > MaxAge Then
Delay 4
Else
Delay .2
End If
If CurDate - FileSearch.DosDate > MaxAge + 15 Then 'What age to kill.
NewFile = LeftPad(FileSearch.Name,12)
FOR NumInt1 = 1 to 26 'Setup to check all possible 26 packets per user.
ChaStr2 = Trim(Left(NewFile,8)) + ".QW" + Chr(64 + NumInt1)
OldFile = QWKRoute + ChaStr2
If Exists(OldFile) then 'Check to see if a old file exists.
Locate 6,1
Print P1;"Last expired QWK Packet."
CLREOL
Print P2;ChaStr2;P4;" has expired and was removed.": Delay 3
Del OldFile 'Terminate old Packets.
ChaStr1 = "QWK2: Deleted expired packet " + ChaStr2 + "."
ActivityLog ChaStr1 'Log deleted file.
End If 'End If Exists check.
Next NumInt1 'Get next one of 26 possible per user account.
End If 'End of date check.
NumInt2 = FindNext(FileSearch) 'Check to see if we are out of files.
Loop 'Go back and continue loop
Print:Print P1;"Finished checking for Expired packets.":Delay 3
Return 'Proper end of CleanOut subroutine.
'>>>----> End of CleanOut
'>>>----> Start of Problem Goto
Problem: 'Come here if there is a drop dead error needing sysop attention.
CLS: Print
If BadEnd = 0 Then
Print P4;"Your QWK2HOLD.CFG file was not located." 'Where is it.
End If 'End Error #0.
'Reserve BadEnd 1 - 20 for .CFG file checking
If BadEnd >= 1 and BadEnd <=10 Then 'Something wrong with configuation file.
Print P1;"Line #";P2;BadEnd;P1;" of the QWK2HOLD.CFG has a problem." 'What line is bad.
End If 'End Error #1 - 20.
Print
Print P1;"The current values of your ";P2;"QWK2HOLD.CFG";P1;" file are";P2;":"
Print P1;"Line #1 = [";P2;WCMailRoute;P1;"]"
Print P1;"Line #2 = [";P2;WCMailZip;P1;"]"
Print P1;"Line #3 = [";P2;QWKRoute;P1;"]"
Print P1;"Line #4 = [";P2;QWKFlag;P1;"]"
Print P1;"Line #5 = [";P2;SecPro1;P1;"]"
Print P1;"Line #6 = [";P2;SecPro2;P1;"]"
Print P1;"Line #7 = [";P2;MaxPacket;P1;"]"
Print P1;"Line #8 = [";P2;MaxAge;P1;"]"
Print P1;"Line #9 = [";P2;MaxSize;P1;"]"
Print P1;"Line #10 = [";P2;MsgPlace;P1;"]"
Print P1;"Line #11 = [";P2;Mid(P1,2,2);P1;"]"
Print P1;"Line #12 = [";P2;Mid(P2,2,2);P1;"]"
Print P1;"Line #13 = [";P2;Mid(P3,2,2);P1;"]"
Print P1;"Line #14 = [";P2;Mid(P4,2,2);P1;"]"
Print P1;"Line #15 = [";P2;QWKInbound;P1;"]"
Print
WaitEnter
ChaStr2 = "QWK2 Ended with on an error of some kind"
Print: Print ChaStr2
ActivityLog ChaStr2
ChaStr2 = "Check line #"+ Str(BadEnd) + " of the QWK2HOLD.CFG."
Print: Print Chastr2
ActivityLog ChaStr2
End' End here if program ends in an error.
'>>>----> End of Problem Goto.